# Summary method for ProtocolApplications 
# 
###############################################################################

#' Shows the protocolApplication structure.
#' 
#' The action taken by the protocolApplication is shown. If the ProtocolApplication has a protocolList action
#' the ProtocolApplications listed will be shown recursively. ProtocolApplications listed under a protocolList
#' are indented by tabs, one tab per protocolList beneath the ProtocolApplication on which summary was called.
#' ProtocolApplications and actions are listed by their name separated by a colon, i.e. ProtocolApplication:Action  
#' @param object The ProtocolApplication to summarize.
#' @param ... ignored
#' @export
#' @aliases  summary,ProtocolApplication-method
setMethod("summary", signature(object="ProtocolApplication"), function (object, ...){
    actions <- getProtocolStructure(object)
    for(i in seq(along=actions))
    {
        indentation <- paste(rep.int("\t", actions[i]), sep="", collapse="" )
        cat(indentation)
        cat(names(actions)[i])
        cat("\n")
    }
})
# see documentation below
setGeneric(name="reportSummary",
        def=function(protocolApplication, report) standardGeneric("reportSummary") )

#' Write a Summary of a protocolApplication to a report. 
#' 
#' In order to provide nice output using the features of the different formats we provide specialized implementations.
#' @param protocolApplication the ProtocolApplication to summarize
#' @param report the Report object 
#' @export 
#' @aliases reportSummary reportSummary-methods reportSummary,ProtocolApplication,HtmlReport-method
setMethod("reportSummary", signature(protocolApplication="ProtocolApplication", report="HtmlReport"), 
   function(protocolApplication,report)
{
        # get the correct output file from the report.
        file <- getValue(getValue(report,"currentReport"),"name") # TODO THIS detial should not be exposed add function to reporting 
    
       # each protocol is represented as a table, with options, settings and sub protocols
       tableStart <- "<table border=1 class=dataframe> \n  <tbody>\n"
       tableEnd <- " </tbody> \n </table> \n"
       tableHead <- paste("<tr> <th colspan = 2>",protocolApplication@name ,"</th> </tr>\n")
       tr <- function(file,...)
       {
           cat("<tr> ",file=file,append=TRUE)
           arg<- list(...)
           lapply(arg, function(x) cat(paste("<td>",x,"</td>") ,file=file,append=TRUE))
           cat("</tr>\n",file=file,append=TRUE)
       }
       tableFromList <- function(listData)
       {
           table <- tableStart
           for ( i in  seq(along.with=listData ))
           {
               listItem <- listData[[i]]
               if (is.atomic(listItem))
                   listItem <- paste(listItem, collapse="<br>")
               else
                 listItem <- paste(capture.output(print(listItem)), collapse="<br>")
               table <- paste(table, "<tr> <td>", names(listData)[i], "</td><td>", listItem, "</td></tr>\n" )
           }
           table <- paste(table,tableEnd)
           return(table)
       }
       cat(tableStart,file=file,append=TRUE)
       cat(tableHead,file=file,append=TRUE)
       tr(file=file,"Action",attr(protocolApplication@.action, which="name"))
       if (length(protocolApplication@parameterValues)>0 )
       parameterTab <- tableFromList(protocolApplication@parameterValues)
       else
       parameterTab <- "none"
       settingTab <- tableFromList(list("Output Data"=protocolApplication@outputData,"Input Data Descriptor"=protocolApplication@.dataLocationFile ))
       tr(file=file,"Settings",settingTab)
       tr(file=file,"Parameters",parameterTab)
       if (length(protocolApplication@.childProtocolApplications)>0 )
       {
        cat("<tr> <td> Sub-Protocols </td> <td>",file=file,append=TRUE)
        lapply(protocolApplication@.childProtocolApplications,reportSummary,report)
        cat("</td> </tr>",file=file,append=TRUE)
    }
       cat(tableEnd,file=file,append=TRUE)
       

                       
})

#' Query the structure of a ProtocolApplication
#' 
#' Helper for summary, getProtocolStructure will recursively walk through the ProtocolApplications children
#' and return the actions together with their recursion depth. The
#' actual return value is a vector of depths i.e. executions of protocolList with the actions in its names attribute.
#' @param protocolApplication The protocolApplication whose structure should be returned
#' @return A vector of integers, indicating the number of recursive executions of protocolList. 
#' One integer for each action in the protocol, ordered by the sequence of actions in the protocol. The top level
#' is 0. The names attribute of the vector stores the name of the ProtocolApplication and the name of the action
#' separated by a colon.
#' @author Bastian R. Angermann
getProtocolStructure <- function(protocolApplication)
{
    # this is a bit ugly but R doesn't like concatenating vectors and keeping attributes other than names.
    # therefore we store the recursion depth in our vector and use the name attribute to store the action.
    depth <- 0
    names(depth) <- paste(protocolApplication@name,attr(protocolApplication@.action, which="name"),sep=":")
 
    childActions <- sapply(protocolApplication@.childProtocolApplications,function(x) 
                getProtocolStructure(x)+1 ) 

    return(unlist(c(depth,childActions)) )
}
